home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcpm.arc / CPACORC.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  2.4 KB  |  81 lines
  1. 10  REM **** CPACORC ****
  2. 20  CLOSE
  3. 50  DEFINT B-Z:DEFSNG A
  4. 100  DIM X$(12),D$(500),O2(500),D(500),A6(500),P(500),B(500),T(500)
  5. 120  DIM S(500),F(500),N(500)
  6. 150  GOSUB 5000   'READ INPUT FILE
  7. 160  PRINT : PRINT "**** THIS MODULE ALLOWS YOU TO CHANGE NODES EITHER MATHEMATICALLY OR BY ****"
  8. 170  PRINT "****       USING A [.NDS] FILE SET UP BY OPTION 10 OF THE MAIN MENU     ****"
  9. 180  PRINT : INPUT "Change Mathematically, by [.NDS] File, or Quit (M/F/Q) ";Q$
  10. 182  IF LEFT$(Q$,1)="F" THEN 190
  11. 184  IF LEFT$(Q$,1)="Q" THEN 720
  12. 186  GOTO 450
  13. 190  H$=F$+".NDS"
  14. 200  ON ERROR GOTO 400
  15. 210  OPEN H$ FOR INPUT AS #2
  16. 220  J=0
  17. 230  J=J+1
  18. 240  IF EOF(2) THEN 270
  19. 250  INPUT #2,N(J)
  20. 260  GOTO 230
  21. 270  NN=J-1:PRINT "**** NUMBER OF UNIQUE NODES =";NN;"****"
  22. 272  PRINT "**** MAXIMUM SPACING BETWEEN NODES IS";INT(1000/NN);"****"
  23. 274  PRINT :INPUT "Enter the desired separation ";SEP:SEP=INT(SEP)
  24. 276  IF SEP>INT(1000/NN) THEN BEEP:GOTO 272
  25. 278  PRINT "**** THIS COULD TAKE A WHILE - RELAX ****"
  26. 280  FOR I=1 TO N
  27. 290   FOR J=1 TO NN
  28. 300    IF S(I)=N(J) THEN S(I)=J*SEP:GOTO 308
  29. 304   NEXT J
  30. 308   FOR K=J+1 TO NN
  31. 310    IF F(I)=N(K) THEN F(I)=K*SEP:GOTO 330
  32. 320   NEXT K
  33. 330  IF I MOD 10=0 THEN PRINT I;
  34. 340  NEXT I
  35. 350  GOTO 550
  36. 400  BEEP:PRINT "**** FILE ";H$;" NOT FOUND - CREATE WITH OPTION 10 ****":RESUME 180
  37. 450  INPUT "Enter amount to multiply to all nodes ",M8
  38. 460  IF N8*M8>1000 THEN PRINT "**** MAXIMUM MULTIPLE IS";INT(1000/N8);" TRY AGAIN (ENTER 1 FOR NO CHANGE) ****" ELSE 480
  39. 470  GOTO 450
  40. 480  INPUT "Enter amount to add to all nodes ",A8
  41. 482  IF N8*M8+A8>1000 THEN PRINT "**** MAXIMUM ADDITION IS";1000-N8*M8;"TRY AGAIN (ENTER 0 FOR NO CHANGE) ****" ELSE 490
  42. 484  GOTO 480
  43. 490  FOR I=1 TO N
  44. 500  S(I)=S(I)*M8
  45. 510  F(I)=F(I)*M8
  46. 520  S(I)=S(I)+A8
  47. 530  F(I)=F(I)+A8
  48. 540  NEXT I
  49. 550  REM **** ROUTINE TO UPDATE INPUT FILE ****
  50. 560  OPEN G$ FOR OUTPUT AS #1
  51. 580  WRITE #1,P$,T6$,DA$
  52. 640  FOR I=1 TO N
  53. 650  WRITE #1,D$(I),S(I),F(I),O2(I),D(I),A6(I),P(I),B(I),T(I)
  54. 660  NEXT I
  55. 690  PRINT "**** FILE ";G$;" UPDATED ****"
  56. 700  PRINT
  57. 705  CLOSE #1
  58. 710  INPUT "Press ENTER to continue ",Q$
  59. 720  CHAIN "CPAMENU"
  60. 5000  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  61. 5010  INPUT "Enter the name of the input file [.CPM] ";G$
  62. 5015  IF G$="Q" OR G$="QUIT" THEN 720
  63. 5020  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  64. 5030  IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
  65. 5035  ON ERROR GOTO 5300
  66. 5037  G$=F$+".CPM"
  67. 5040  OPEN G$ FOR INPUT AS #3
  68. 5050  INPUT #3,P$,T6$,DA$
  69. 5060  I=0
  70. 5070  I=I+1
  71. 5080  IF EOF(3) THEN 5130
  72. 5090  INPUT #3,D$(I),S(I),F(I),O2(I),D(I),A6(I),P(I),B(I),T(I)
  73. 5100  IF F(I)>N8 THEN N8=F(I)  'HIGHEST END NODE =N8
  74. 5110  IF I MOD 20=0 THEN PRINT I;
  75. 5120  GOTO 5070
  76. 5130  N=I-1
  77. 5150  CLOSE #3
  78. 5160  PRINT " **** INPUT FILE READ ****"
  79. 5170  RETURN
  80. 5300  PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 5000
  81.